home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / arc / fact127.zip / SMALLEST.PAS < prev   
Pascal/Delphi Source File  |  1996-04-02  |  6KB  |  237 lines
  1. {$N-,E- no math support needed}
  2. {$X- function calls may not be discarded}
  3. {$I- disable I/O checking (trap errors by checking IOResult)}
  4.  
  5. PROGRAM Save_Only_The_Smallest_File;
  6. USES DOS;
  7. VAR
  8.   TestExts: STRING;
  9.  
  10. PROCEDURE Help (problem: BYTE);
  11. (* If any *foreseen* errors arise, we are sent here to
  12.    give a little help and exit (relatively) peacefully *)
  13. CONST
  14.   lf = #13#10;
  15. VAR
  16.   message: STRING [50];
  17. BEGIN
  18.   WriteLn ('SMALLEST v1.00 - DOS utility: Save only the SMALLEST file. (Use with "FACT")');
  19.   WriteLn ('Copyright (c) April 2, 1996, by David Daniel Anderson - Reign Ware.' + lf);
  20.   WriteLn ('Usage   :  SMALLEST  file_spec  .ext .ex2 .ex3 .ex4 .etc ' + lf);
  21.   WriteLn ('Example :  SMALLEST  *.*  .zip .arj .rar .uc2');
  22.   WriteLn ('        :  SMALLEST  c:\dls\*.*  .acb .ha .yc');
  23.   WriteLn ('        :  SMALLEST  newgame.arj  .arj .rar .zip' + lf);
  24.   IF problem > 0 THEN BEGIN
  25.     CASE problem OF
  26.       1 : message := 'No files matching specification found.';
  27.       ELSE  message := 'Unanticipated error of unknown type.';
  28.     END;
  29.     WriteLn ('Error #', problem, ' - ', message);
  30.   END;
  31.   Halt (problem)
  32. END;
  33.  
  34. FUNCTION Comma (num : LONGINT): STRING; {insert commas to break up number string}
  35. VAR s : STRING [14];
  36.   l : SHORTINT;
  37. BEGIN
  38.   Str (num, s);
  39.   l := (Length (s) - 2);
  40.   WHILE (l > 1) DO BEGIN
  41.     Insert (',', s, l);
  42.     Dec (l, 3);
  43.   END;
  44.   Comma := s;
  45. END;
  46.  
  47. FUNCTION RPad (bstr: STRING; len: BYTE): STRING;
  48. BEGIN
  49.   WHILE (Length (bstr) < len) DO
  50.     bstr := bstr + #32;
  51.   RPad := bstr;
  52. END;
  53.  
  54. FUNCTION Upper (lstr : STRING): STRING;
  55.   PROCEDURE UpFast (VAR Str: STRING);  {** from SWAG **}
  56.   INLINE($8C/$DA/$5E/$1F/$FC/$AC/$30/$E4/$89/$C1/$E3/$12/$BB/Ord('a')/Ord('z')/
  57.          $AC/$38/$D8/$72/$08/$38/$F8/$77/$04/$80/$6C/$FF/$20/$E2/$F1/$8E/$DA);
  58. BEGIN
  59.   UpFast (lstr);
  60.   Upper := lstr;
  61. END;
  62.  
  63. FUNCTION IsFile (CONST FileName: PATHSTR): BOOLEAN;
  64. VAR
  65.   Attr  : WORD;
  66.   cFile : FILE;
  67. BEGIN
  68.   Assign (cFile, FileName);
  69.   GetFAttr (cFile, Attr);
  70.   IF (DosError = 0) AND ((Attr AND Directory) <> Directory)
  71.     THEN IsFile := TRUE
  72.     ELSE IsFile := FALSE;
  73. END;
  74.  
  75. PROCEDURE EraseFile (CONST FileName : PATHSTR);
  76. VAR
  77.   cFile : FILE;
  78. BEGIN
  79.   IF IsFile (FileName) THEN BEGIN
  80.     Assign (cFile, FileName);
  81.     SetFAttr (cFile, 0);
  82.     Erase (cFile);
  83.   END;
  84. END;
  85.  
  86. FUNCTION getFileExt (fn: PATHSTR): EXTSTR;
  87. VAR
  88.   p: BYTE;
  89. BEGIN
  90.   p := (Pos ('.', fn));
  91.   IF (p > 0)
  92.     THEN getFileExt := Copy (fn, p, 1 + Length (fn) - p)
  93.     ELSE getFileExt := '';
  94. END;
  95.  
  96. FUNCTION getFileName (fn: PATHSTR): NAMESTR;
  97. VAR
  98.   p: BYTE;
  99.   b: BOOLEAN;
  100. BEGIN
  101.   b := TRUE;
  102.   WHILE b DO
  103.   BEGIN
  104.     p := Pos ('\', fn);
  105.     IF (p > 1)
  106.       THEN fn := Copy (fn, p+1, Length (fn) - p)
  107.       ELSE b := FALSE;
  108.   END;
  109.   IF (Pos ('.', fn) > 0)
  110.     THEN getFileName := Copy (fn, 1, (Pos ('.', fn) - 1))
  111.     ELSE getFileName := fn;
  112. END;
  113.  
  114. FUNCTION IsDir (CONST FileName: PATHSTR): BOOLEAN;
  115. VAR
  116.   Attr  : WORD;
  117.   cFile : FILE;
  118. BEGIN
  119.   Assign (cFile, FileName);
  120.   GetFAttr (cFile, Attr);
  121.   IF (DosError = 0) AND ((Attr AND Directory) = Directory)
  122.     THEN IsDir := TRUE
  123.     ELSE IsDir := FALSE;
  124. END;
  125.  
  126. FUNCTION GetFilePath (CONST PSTR: STRING; VAR sDir: DIRSTR): PATHSTR;
  127. VAR
  128.   dirinfo   : SEARCHREC;
  129.   jPath     : PATHSTR;  { file path,       }
  130.   jDir      : DIRSTR;   {      directory,  }
  131.   jName     : NAMESTR;  {      name,       }
  132.   jExt      : EXTSTR;   {      extension.  }
  133. BEGIN
  134.   jPath := PSTR;
  135.   IF jPath = '' THEN jPath := '*.*';
  136.   IF (NOT (jPath [Length (jPath) ] IN [':', '\'])) AND IsDir (jPath) THEN
  137.     jPath := jPath + '\';
  138.   IF (jPath [Length (jPath) ] IN [':', '\']) THEN
  139.     jPath := jPath + '*.*';
  140.  
  141.   FSplit (FExpand (jPath), jDir, jName, jExt);
  142.   jPath := jDir + jName+ jExt;
  143.  
  144.   sDir := jDir;
  145.   GetFilePath := jPath;
  146. END;
  147.  
  148. PROCEDURE Inform (Action, fName: STRING; fSize: LONGINT);
  149. BEGIN
  150.   WriteLn (Action, ': ', RPad (fName, 40), Comma (fSize):9, ' bytes');
  151. END;
  152.  
  153. PROCEDURE SaveSmallest (fDir: DIRSTR; fName: NAMESTR);
  154. TYPE
  155.   FileInfo = RECORD
  156.                fName : PATHSTR;
  157.                fSize : LONGINT;
  158.              END;
  159. VAR
  160.   DirInfo : SEARCHREC;
  161.   fLast,
  162.   fCurrent : FileInfo;
  163.   Deleted : WORD;
  164.  
  165. BEGIN
  166.   fLast.fName := '';
  167.   fCurrent.fName := '';
  168.   Deleted := 0;
  169.  
  170.   FindFirst (fDir+fName+'.*', Archive, DirInfo);
  171.   WHILE DosError = 0 DO
  172.   BEGIN
  173.     IF (Pos (Upper (getFileExt (DirInfo.Name))+'.', TestExts) > 0) THEN
  174.     BEGIN
  175.       fCurrent.fName := fDir + DirInfo.Name;
  176.       fCurrent.fSize := DirInfo.Size;
  177.       IF fLast.fName = '' THEN
  178.       BEGIN
  179.         fLast.fName := fCurrent.fName;
  180.         fLast.fSize := fCurrent.fSize;
  181.       END
  182.       ELSE BEGIN
  183.         Inc (Deleted);
  184.         IF fCurrent.fSize < fLast.fSize THEN
  185.         BEGIN
  186.           Inform ('Erasing', fLast.fName, fLast.fSize);
  187.           EraseFile (fLast.fName);
  188.           fLast.fName := fCurrent.fName;
  189.           fLast.fSize := fCurrent.fSize;
  190.         END
  191.         ELSE BEGIN
  192.           Inform ('Erasing', fCurrent.fName, fCurrent.fSize);
  193.           EraseFile (fCurrent.fName);
  194.         END;
  195.       END;
  196.     END;
  197.     FindNext (DirInfo);
  198.   END;
  199.   IF Deleted > 0 THEN
  200.   BEGIN
  201.     Inform ('Keeping', fLast.fName, fLast.fSize);
  202.     WriteLn;
  203.   END;
  204. END;
  205.  
  206. VAR
  207.   fPath   : PATHSTR;
  208.   fDir    : DIRSTR;
  209.   DirInfo : SEARCHREC;
  210.   i: BYTE;
  211.   p: STRING;
  212.  
  213. BEGIN
  214.   WriteLn;
  215.   TestExts := '';
  216.   IF ParamCount < 2 THEN Help (0);
  217.   FOR i := 2 to ParamCount DO
  218.   BEGIN
  219.     p := ParamStr (i);
  220.     IF (p[1] = '.') AND (Length (p) IN [2..4]) THEN
  221.       TestExts := TestExts + p;
  222.   END;
  223.   IF TestExts <> '' THEN
  224.   BEGIN
  225.     TestExts := Upper (TestExts) + '.';
  226.     fPath := GetFilePath (ParamStr(1), fDir);
  227.     FindFirst (fPath, Archive, DirInfo);
  228.     WHILE DosError = 0 DO
  229.     BEGIN
  230.       SaveSmallest (fDir, getFileName (DirInfo.Name));
  231.       FindNext (DirInfo);
  232.     END;
  233.   END
  234.   ELSE
  235.     Help (1);
  236. END.
  237.